DP Tool Club 19/CD_ASCQ_19_010295.iso/dos/prg/pas/swag/win_os2.swg/0018_Windows Statusline Unit.pas

Pascal/Delphi Source File | 1994-02-05 | 19KB | 497 lines

(**************************************************************************
 *                                                                        *
 * STATUS.PAS - A Statusline unit, by Thomas S. Carlisle                  *
 *              Free for public use, all I ask is that my name remain     *
 *              with this code.                                           *
 *                                                                        *
 * This unit provides easy implementation of a status line. The           *
 * statusline will be at the bottom of the screen, and will take on the   *
 * colors defined in the system as button face, and button shadow.        *
 *                                                                        *
 * The statusline can have multiple partitions to display different       *
 * information. For example, you could have a partition that displays     *
 * a clock (see STATUSEX.PAS), another one that displays the current      *
 * file open in a word processing application, or virtually anything you  *
 * can think up.                                                          *
 *                                                                        *
 * The main object is TStatusLine. TStatusline is an abstract object with *
 * limited default functionality. TStatusline is a statusline with no     *
 * partitions. It knows how to draw itself, and most importantly it knows *
 * how to insert partitions. However, TStatusline does not Insert any     *
 * partitions. The user must create a descendant object of TStatusLine    *
 * that overrides the Setup method to insert some partitions.             *
 *                                                                        *
 * A typical Setup method may look something like this:                   *
 *  PROCEDURE TMyStatusline.Setup;                                        *
 *  BEGIN                                                                 *
 *       InsertItem(100,DrawProc);                                        *
 *  END;                                                                  *
 *                                                                        *
 * That would insert a partition that is 100 pixels wide. The second      *
 * parameter is important. It is a procedure. Each partition must be      *
 * passed a procedure so it knows who to call to fill in the partition    *
 * with the appropriate text. The procedure passed in the InsertItem      *
 * statement MUST be a procedure that was previously declared like this:  *
 *                                                                        *
 * PROCEDURE DrawProc(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);FAR;  *
 * BEGIN                                                                  *
 *     { your custom draw code goes here... }                             *
 * END;                                                                   *
 *                                                                        *
 * Note proceduremust be declared as FAR. It also MUST have the exact     *
 * parameter list as shown. In the body, you can do what you want. A      *
 * simple example would be to simply write out a line of text:            *
 *                                                                        *
 * PROCEDURE DrawProc(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);FAR;  *
 * BEGIN                                                                  *
 *     TextOut(PaintHdc,3,1,'Test',4);                                    *
 * END;                                                                   *
 *                                                                        *
 * Usually you will not have a simple procedure like that. For a better,  *
 * more functional example see the procedure Clock in STATUSEX.PAS        *
 *                                                                        *
 *************************************************************************)

UNIT Status;

INTERFACE

USES
    WObjects,WinTypes,WinProcs,WinCrt;

TYPE
    TPaintProc = PROCEDURE(PaintHdc : HDC; VAR PaintInfo : TPaintStruct);

    PPartitionCollection = ^TPartitionCollection;

    TPartitionCollection = OBJECT(TCollection)
    END;

    PPartition = ^TPartition;

    TPartition = OBJECT(TWindow)
        PRIVATE
         LeftPosition,
         RightPosition  : WORD;
         PaintProc      : TPaintProc;
         CONSTRUCTOR Init(AParent : PWindowsObject; ATitle : PCHAR;
               LPos,RPos : WORD; Proc : TPaintProc);
         PROCEDURE Paint(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);
              VIRTUAL;
    END;

    PStatusLine = ^TStatusLine;

    TStatusLine = OBJECT(TWindow)
        CONSTRUCTOR Init(AParent : PWindowsObject; ATitle : PCHAR);
        PROCEDURE Paint(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);
              VIRTUAL;
        DESTRUCTOR Done;VIRTUAL;
        PROCEDURE InsertItem(StrLength : WORD; Proc : TPaintProc);
        PROCEDURE Setup;VIRTUAL;
        FUNCTION GetPartition(Index : BYTE):PPartition;VIRTUAL;
        PRIVATE
         Partitions     : PPartitionCollection;
    END;

IMPLEMENTATION

(************************** TPartition Methods ***************************)

{ TPartition is an object descendant of TWindow. All TPartition objects
  are child windows with TStatusLine as the parent.

  When a TPartition is inserted in the statusline, it is automaticlly
  inserted right next to the previous TPartition on the statusline.

  The Init constructor method is called whenevr a new TPartition is
  inserted in the statusline. The parameters of Init include the
  TPartition's parent window, its title (Nil), the TPartitions left position
  on the statusline, it's right position on the statusline, and most
  importantly -- the last parameter -- is a procedure parameter. This
  procedure parameter is a user defined procedure that will be used by
  the TPartition.Paint method.

  Each TPartition knows how to draw itself, with the Paint method. The Paint
  method draws an empty partition (i.e - only the frame, not filled with
  text. The paint method calls the user defined procedure, which is
  responsible for filling the partition frame with the appropriate text.

  See STATUSEX.PAS for an example of the user defined procedure           }


CONSTRUCTOR TPartition.Init(AParent : PWindowsObject; ATitle : PCHAR;
       LPos,RPos : WORD; Proc : TPaintProc);

VAR
   R   : TRect;
BEGIN
     TWindow.Init(AParent,ATitle);
     LeftPosition:=LPos;
     RightPosition:=RPos;
     PaintProc:=Proc;
     WITH Attr DO BEGIN
          Style:=Style OR ws_Child;
          X:=LPos;
          Y:=0;
          W:=RPos-LPos;
          H:=17;
     END;
END;

PROCEDURE TPartition.Paint(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);
VAR
   R : TRect;
   TheBrush,
   OldBrush     : HBrush;
   Pen,
   OldPen       : HPen;
BEGIN
     GetClientRect(HWindow,R);
     TheBrush:=CreateSolidBrush(GetSysColor(color_BtnFace));
     FillRect(PaintHdc,R,TheBrush);
     DeleteObject(TheBrush);

     SetBkColor(PaintHdc,GetSysColor(color_BtnFace));
     PaintProc(PaintHdc,PaintInfo);

     Pen:=CreatePen(ps_Solid,1,RGB(255,255,255));
     OldPen:=SelectObject(PaintHDC,Pen);
     MoveTo(PaintHDC,R.Left,R.Top);
     LineTo(PaintHDC,R.Right,R.Top);
     MoveTo(PaintHdc,R.Left,R.Top);
     LineTo(PaintHdc,R.Left,R.Bottom);
     MoveTo(PaintHdc,R.Left+2,R.Top+15);
     LineTo(PaintHdc,R.Right-3,R.Top+15);
     LineTo(PaintHdc,R.Right-3,R.Top+2);

     DeleteObject(SelectObject(PaintHdc,OldPen));
     Pen:=CreatePen(ps_Solid,1,GetSysColor(color_btnShadow));
     OldPen:=SelectObject(PaintHDC,Pen);
     MoveTo(PaintHdc,R.Left+2,R.Top+2);
     LineTo(PaintHdc,R.Right-3,R.Top+2);
     MoveTo(PaintHdc,R.Right-1,R.Top);
     LineTo(PaintHdc,R.Right-1,R.Bottom);
     MoveTo(PaintHdc,R.Left+2,R.Top+2);
     LineTo(PaintHdc,R.Left+2,R.Top+15);

     DeleteObject(SelectObject(PaintHDC,OldPen));
END;

(*************************** TStatusLine Methods *************************)

{ TStatusLine is an object descendant of TWindow. TStatusLine has a field
  called Partitions, which is a collection of TPartitions.

  The InsertItem method is the method responsible for inserting new
  TPartitions in the Partition collection.

  The Paint method draws the statusline, and iterates through the Partition
  collection call each ones Paint method. This results in the entire
  statusline being redrawn. }


CONSTRUCTOR TStatusLine.Init(AParent : PWindowsObject; ATitle : PCHAR);
BEGIN
     TWindow.Init(AParent,ATitle);
     WITH Attr DO BEGIN
          Style := Style OR ws_Child OR ws_Border;
     END;
     Partitions:=New(PPartitionCollection,Init(1,1));
     Setup;
END;

PROCEDURE TStatusLine.InsertItem(StrLength : WORD; Proc : TPaintProc);
BEGIN
     IF Partitions^.Count=0 THEN BEGIN
        Partitions^.Insert(New(PPartition,Init(@Self,Nil,0,StrLength,
        Proc)));
     END
     ELSE BEGIN
       Partitions^.Insert(New(PPartition,Init(@Self,NIL,PPartition(
          Partitions^.At(Partitions^.Count-1))^.RightPosition,PPartition(
          Partitions^.At(Partitions^.Count-1))^.RightPosition+StrLength,
          Proc)));
     END;
END;

FUNCTION TStatusLine.GetPartition(Index : BYTE):PPartition;
BEGIN
     GetPartition:=NIL;
     IF Partitions^.Count<>0 THEN BEGIN
        GetPartition:=Partitions^.At(Index);
     END;
END;

PROCEDURE TStatusLine.Setup;
BEGIN
END;

PROCEDURE TStatusLine.Paint(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);
VAR
   R         : TRect;
   TheBrush  : HBrush;
   Pen,
   OldPen    : HPen;

   PROCEDURE CallPaint(P : PPartition);FAR;
   BEGIN
        P^.Paint(PaintHDC,PaintInfo);
   END;

BEGIN
     GetClientRect(Parent^.HWindow,R);
     MoveWindow(HWindow,0,R.Bottom-18,R.Right-R.Left,R.Bottom,TRUE);

     GetClientRect(HWindow,R);
     IF Partitions^.Count<>0 THEN BEGIN
        R.Left:=PPartition(
              Partitions^.At(Partitions^.Count-1))^.RightPosition;
     END;
     TheBrush:=CreateSolidBrush(GetSysColor(color_BtnFace));
     FillRect(PaintHdc,R,TheBrush);
     DeleteObject(TheBrush);

     Pen:=CreatePen(ps_Solid,1,RGB(255,255,255));
     OldPen:=SelectObject(PaintHDC,Pen);
     MoveTo(PaintHDC,R.Left,R.Top);
     LineTo(PaintHDC,R.Right,R.Top);
     MoveTo(PaintHdc,R.Left,R.Top);
     LineTo(PaintHdc,R.Left,R.Bottom);
     MoveTo(PaintHdc,R.Left+2,R.Top+15);
     LineTo(PaintHdc,R.Right-3,R.Top+15);
     LineTo(PaintHdc,R.Right-3,R.Top+2);

     DeleteObject(SelectObject(PaintHdc,OldPen));
     Pen:=CreatePen(ps_Solid,1,GetSysColor(color_btnShadow));
     OldPen:=SelectObject(PaintHDC,Pen);
     MoveTo(PaintHdc,R.Left+2,R.Top+2);
     LineTo(PaintHdc,R.Right-3,R.Top+2);
     MoveTo(PaintHdc,R.Right-1,R.Top);
     LineTo(PaintHdc,R.Right-1,R.Bottom);
     MoveTo(PaintHdc,R.Left+2,R.Top+2);
     LineTo(PaintHdc,R.Left+2,R.Top+15);

     DeleteObject(SelectObject(PaintHdc,OldPen));

     Partitions^.ForEach(@CallPaint);
END;


DESTRUCTOR TStatusLine.Done;
BEGIN
     Dispose(Partitions,Done);
     TWindow.Done;
END;

END.

{------------------------   DEMO -------------------------}

 (*************************************************************************
 *                                                                        *
 * STATUSEX.PAS - example program using the STATUS unit.                  *
 *                By Thomas S. Carlisle                                   *
 *                                                                        *
 *                                                                        *
 * This program sets up an example application demonstrating the use of   *
 * the STATUS unit. A main window is created that has a statusline with   *
 * a single partition that will display the current time.                 *
 *                                                                        *
 * I picked a clock example because it demonstrates how the main window   *
 * can communicate with the statusline to tell it a certain partition     *
 * needs to be redrawn.                                                   *
 *                                                                        *
 *************************************************************************)

PROGRAM StatusEx;
USES
    WObjects,WinTypes,WinProcs,Status,WinDOS,Strings;

CONST
     wm_UpdateTime   = $0400;  { User defined message }

TYPE
    TimeRec = RECORD
            Hour,
            Min     : WORD;
    END;

    PMyStatusLine = ^TMyStatusLine;

    TMyStatusLine = OBJECT(TStatusLine)
        PROCEDURE Setup;VIRTUAL;
        PROCEDURE UpdateTime(VAR Msg : TMessage);
             VIRTUAL wm_First + wm_UpdateTime;
    END;

    PMyWindow = ^TMyWindow;

    TMyWindow = OBJECT(TWindow)
         StatusLine    : PMyStatusLine;
         CONSTRUCTOR Init(AParent : PWindowsObject; ATitle : PCHAR);
         PROCEDURE SetupWindow;VIRTUAL;
         DESTRUCTOR Done;VIRTUAL;
         PROCEDURE Timer(VAR Msg : TMessage);VIRTUAL wm_Timer;
    END;

    TMyApp = OBJECT(TApplication)
           PROCEDURE InitMainWindow;VIRTUAL;
    END;


(********************************* Globals **************************)

VAR
   OldTime      : TimeRec;    { OldTime will be used to keep track of
                                whether or not the time has changed and
                                needs to be redrawn                       }

PROCEDURE Clock(PaintHdc : HDC; VAR PaintInfo : TPaintStruct);FAR;

{ This procedure MUST be declared as FAR because it is passed as a
  parameter to the statusline, so the statusline will know what procedure
  to call when the statusline needs to be drawn. The statusline draws the
  actual box, but this procedure must fill in the text.

  Note the parameter list. It is mandatory, but also convenient. You will
  need to use the PaintHDC as the device context for your text output. The
  PaintInfo is there just in case you need it. All procedures designed to be
  passed to the statusline to be used to fill in the statusline partitions
  MUST have these two parameters!

  This procedure simply fills the box with the current time.              }

VAR
   TimeStr      : ARRAY[0..5] OF CHAR;
   Hour,
   Minute,
   Sec,
   HSec         : WORD;
   TempStr,
   Temp1        : ARRAY[0..2] OF CHAR;
BEGIN
     StrCopy(TimeStr,' ');
     GetTime(Hour,Minute,Sec,HSec);
     OldTime.Hour:=Hour;          { Fill in OldTime record for future use }
     OldTime.Min:=Minute;
     Str(Hour,TempStr);           { Build the string that holds the time }
     StrCat(TimeStr,TempStr);
     StrCopy(TempStr,':');
     StrCat(TimeStr,TempStr);
     Str(Minute,TempStr);
     IF StrLen(TempStr)=1 THEN BEGIN
         StrCopy(Temp1,'0');
         StrCat(Temp1,TempStr);
         StrCopy(TempStr,Temp1);
     END;
     StrCat(TimeStr,TempStr);
     TextOut(PaintHdc,3,1,TimeStr,StrLen(TimeStr));   { Output the time }
END;

(************************ TMyStatusLine Methods ************************)

PROCEDURE TMyStatusLine.UpdateTime(VAR Msg : TMessage);

{ This procedure is a response method for TMyStatusLine. It responds to
  the wm_UpdateTime user defined message. The procedure first checks
  the current time against the time in OldTime. If they are different,
  then the clock status window is invalidated, to force it to be redrawn
  with the new time.

  The reason this program is setup to keep track of the OldTime, and have
  this procedure check it, is to avoid flicker that occurs if the time
  is updated when it isn't necessary.                                    }

VAR
   Hour,Min,Sec,HSec : WORD;
BEGIN
     GetTime(Hour,Min,Sec,HSec);
     IF (OldTime.Hour<>Hour) OR (OldTime.Min<>Min) THEN
          InvalidateRect(GetPartition(0)^.HWindow,NIL,TRUE);
END;

PROCEDURE TMyStatusLine.Setup;

{ Overrides the inherited Setup method. This setup method inserts one
  statusline partition in the status line. }

BEGIN
     InsertItem(75,Clock);  { This inserts a new item in the statsuline.
                              The first parameter is the length (in pixels)
                              of the desired statusline partition. The
                              second parameter is the procedure this new
                              partition will call whenever it needs to be
                              redrawn. As stated earlier, the statusline
                              takes care of drawing the statusline and it's
                              partitions, but the procedure passed here is
                              responsible for filling the partition with
                              text }

                            { If you need more than one partition,
                              simply add more InsertItem statements. Each
                              one can be passed a length and procedure
                              parameter. Very powerful.                  }

END;

(************************* TMyWindow Methods ***************************)

CONSTRUCTOR TMyWindow.Init(AParent : PWindowsObject; ATitle : PCHAR);

{ TMyWindow is a descendant of TWindow. The only difference is it has a
  StatusLine.                                                              }

BEGIN
     TWindow.Init(AParent,ATitle);
     Statusline:=New(PMyStatusLine,Init(@Self,Nil));
END;

PROCEDURE TMyWindow.SetupWindow;

{ SetupWindow is needed in this application to start the timer that will
  be used to spark messages every second to make sure the statusline clock
  is kept up to date.                                                      }

BEGIN
     TWindow.SetupWindow;
     IF SetTimer(HWindow,1,1000,NIL) = 0 THEN
        MessageBox(HWindow,'ERROR','Timer not available',mb_OK);
END;

PROCEDURE TMyWindow.Timer(VAR Msg : TMessage);

{ Responds to wm_Timer messages. First checks to make sure the incomming
  message is ours (ID=1). If it is, it sends a wm_UpdateTime message
  to the statusline. That is the message the statusline responds to by
  updating the time, if it has changed.                                   }

BEGIN
     IF Msg.wParam=1 THEN BEGIN
        SendMessage(StatusLine^.HWindow,wm_UpdateTime,0,0);
     END;
END;

DESTRUCTOR TMyWindow.Done;
{ Cleans up by killing the timer we started, and disposing the statusline }
BEGIN
     KillTimer(HWindow,1);
     Dispose(StatusLine,Done);
     TWindow.Done;
END;

(****************************** TMyApp Methods ************************)

PROCEDURE TMyApp.InitMainWindow;
{ Gets our main window (TMyWindow) in action }
BEGIN
     MainWindow:=New(PMyWindow,Init(NIL,'Test'));
END;

VAR
   MyApp   : TMyApp;
BEGIN
     MyApp.Init('Test');
     MyApp.Run;
     MyApp.Done;
END.